Attribute VB_Name = "MODdbMethods"
Dim _
    openStr As String, _
    intTotalMatches As Integer, _
    strFieldsList As String, _
    strColumnWidths As String

Private _
    oConn As ADODB.Connection, _
    oRS As ADODB.Recordset, _
    oField As Field

Private sDatabasePath As String

Private strRowToUpdateList As String

Public fso As Scripting.FileSystemObject

Public Function init()

    On Error Resume Next

    Dim sFilePath As String
    
    sFilePath = getPref("", "defaultDatabasePath")
    
    Set fso = New Scripting.FileSystemObject
     
    If Not fso.FileExists(sFilePath) Then Exit Function

   ' Open the default database ---------------------------------------------------------------------------------------------
    
    openConnection sFilePath
    
End Function

Public Sub openConnection(sDatabasePath As String)

    On Error Resume Next
    
    Dim sConn As String

    Set oConn = New ADODB.Connection

    sConn = "PROVIDER=MICROSOFT.JET.OLEDB.4.0;DATA SOURCE=" & sDatabasePath
    
    FRMmain.Adodc1.ConnectionString = sConn
    
    oConn.Open FRMmain.Adodc1.ConnectionString
    
    If Err.Number <> 0 Then
    
        logMessage _
            1, _
            "MODdbMethods", _
            "Could not open ADODB connection", _
            "Connection String = " & sConn, _
            Err.Number, _
            Err.Description
    
        MsgBox _
            "Could not open connection to database : " & sDatabasePath & vbCrLf & _
                "Reason : " & Err.Description
                
        Exit Sub
                
    Else
    
    End If
    
    Set oRS = oConn.OpenSchema(adSchemaTables)
    
    FRMmain.LISTtables.Clear
    
    Do Until oRS.EOF
    
        If oRS!TABLE_TYPE = "TABLE" Then
        
            FRMmain.LISTtables.AddItem (oRS!TABLE_NAME)
            
        End If
        
        oRS.MoveNext
      
    Loop
    
    FRMmain.LISTfields.Text = "All"
    FRMmain.LISTtables.ListIndex = 0
    
    oRS.Close
    oConn.Close
    
    Set oRS = Nothing
    Set oConn = Nothing
        
End Sub

' Loop through the fields in the selected table, and add each one to the listbox in the main form -------------------------------------------------------------------------

Public Function setFieldsList(sTable As String, sDefaultField As String)

    On Error Resume Next
    
    Set fso = New Scripting.FileSystemObject
    
    Dim _
        sRSOpen As String

    Dim i As Integer

    Set oConn = New ADODB.Connection
    Set oRS = New ADODB.Recordset
    
    oConn.Open FRMmain.Adodc1.ConnectionString
    
    If Err.Number <> 0 Then
    
        Exit Function
    
    End If
     
    sRSOpen = "SELECT * FROM " & sTable
    
    oRS.Open sRSOpen, oConn, 1, 3
    
    FRMmain.LISTfields.Clear
    
    FRMmain.LISTfields.AddItem "All"
    
    ' Loop through the fields in the table, and add them to the list box ---------------------------------------------------------------------------------
    
    For Each oField In oRS.Fields
    
        FRMmain.LISTfields.AddItem oField.Name
    
    Next

' Select the default search field --------------------------------------------------------------------------------------------------

    For i = 0 To FRMmain.LISTfields.ListCount
        
        If FRMmain.LISTfields.List(i) = sDefaultField Then
            
            FRMmain.LISTfields.Selected(i) = True
            
            Exit For
        
        End If
    
    Next
    
    oRS.Close
    oConn.Close
    
        
    Set oRS = Nothing
    Set oConn = Nothing

errHandler:
    
    If Err.Number = -2147467259 Then
    
        MsgBox "The dataBase you are attempting to open is already open outside of the application"
        
    End If

    Exit Function

End Function
'---------------------------------------'
'   Search DataBase                     '
'---------------------------------------'
Public Function searchDB(tableToSearch As String, fieldTosearch As String, queryStr As String)

    On Error Resume Next
    
''on error GoTo handleError
    FRMmain.MousePointer = 11
    strWhere = ""
    
'---------------------------------------------------------------------------------------'
'   get string matching criteria from radio buttons                                     '
'---------------------------------------------------------------------------------------'
    If FRMmain.optionAnyMatch.Value = True Then
        queryStr = "%" & queryStr & "%"
    ElseIf FRMmain.optionExactMatch.Value = True Then
        queryStr = queryStr
    ElseIf FRMmain.optionStartsWith.Value = True Then
        queryStr = queryStr & "%"
    ElseIf FRMmain.optionEndsWith.Value = True Then
        queryStr = "%" & queryStr
    ElseIf FRMmain.optionWildCard.Value = True Then
        queryStr = Replace(queryStr, " ", "")
        queryStr = Replace(queryStr, "/", "")
        queryStr = Replace(queryStr, "\", "")
        queryStr = Replace(queryStr, "-", "")
        queryStr = Replace(queryStr, "/", "")
        queryStr = Replace(queryStr, "(", "")
        queryStr = Replace(queryStr, ")", "")
        queryStr = Replace(queryStr, "[", "")
        queryStr = Replace(queryStr, "]", "")
        queryStr = Replace(queryStr, "_", "")
        queryStr = Replace(queryStr, "|", "")
        queryStr = Replace(queryStr, """", "")
        queryStr = Replace(queryStr, "'", "")
        queryStr = Replace(queryStr, ",", "")
        queryStr = Replace(queryStr, ".", "")
        tempstr = "%"
        For i = 1 To Len(queryStr)
            tempstr = tempstr & Mid(queryStr, i, 1) & "%"
        Next
        queryStr = tempstr
    End If
'---------------------------------------------------------------------------------------'
'   create "WHERE" clause for SQL statement                                             '
'---------------------------------------------------------------------------------------'
    If fieldTosearch = "All" Then
        strWhere = " WHERE "
        arrFieldsList = Split(strFieldsList, ",")
        For Each fldName In arrFieldsList
            strWhere = strWhere & tableToSearch & ".[" & fldName & "] LIKE '" & queryStr & "' OR "
        Next
        strWhere = Left(strWhere, Len(strWhere) - 3)
    Else
        strWhere = " WHERE " & tableToSearch & ".[" & fieldTosearch & "] LIKE '" & queryStr & "'"
    End If
    openStr = "SELECT * FROM " & tableToSearch & strWhere
    FRMmain.Adodc1.RecordSource = openStr
    FRMmain.Adodc1.Refresh
    Dim rs As Recordset
    Set rs = FRMmain.Adodc1.Recordset
    FRMmain.LBLresultsCount.Caption = rs.RecordCount
'---------------------------------------------------------------------------------------'
'   set column widths for the dataGrid after each search                                '
'---------------------------------------------------------------------------------------'
    i = 0
    For Each fld In rs.Fields
    
        If IsArray(aColumnWidths) Then
        
            If IsNumeric(aColumnWidths(i)) Then
            
                intColumnWidth = aColumnWidths(i)
                
            Else
            
                intColumnWidth = 50
                
            End If
            
        Else
        
            intColumnWidth = 50
            
        End If
        
        FRMmain.DataGrid.Columns(i).Width = intColumnWidth
        
        If IsArray(aColumnWidths) Then
        
            If i < UBound(aColumnWidths) Then
            
                i = i + 1
                
            End If
            
        End If
        
    Next
    intTotalSearchResults = 0
    FRMmain.MousePointer = 0
    strWhere = ""
    
handleError:
    If Err.Number <> 0 Then
        If Err.Number = -2147217900 Then
            MsgBox "You Have Entered Invalid Search Criteria" & vbCrLf & "Please Try Again"
            FRMmain.TXTsearch.SetFocus
            FRMmain.TXTsearch.SelStart = 0
            FRMmain.TXTsearch.SelLength = Len(FRMmain.TXTsearch.Text)
        Else
            MsgBox "Error : " & Err.Description & "Error Number : " & Err.Number
        End If
    End If
    FRMmain.MousePointer = 0
End Function
'-----------------------------------------------------'
'   Save edited row to database                       '
'-----------------------------------------------------'
Public Function setRowToUpdate(strFieldsList)
    
    On Error Resume Next
    
    strRowToUpdateList = strFieldsList
End Function
Public Function saveRow()

    On Error Resume Next

    Dim _
        conn As ADODB.Connection, _
        rs As ADODB.Recordset
    
    Dim _
        strConn As String, _
        openStr As String

    Set conn = New ADODB.Connection
    Set rs = New ADODB.Recordset

    strConn = "PROVIDER=MICROSOFT.JET.OLEDB.4.0;DATA SOURCE=" & sDatabasePath
    
    conn.Open strConn
    
    rs.ActiveConnection = conn

    openStr = "UPDATE " & FRMmain.LISTtables.List(FRMmain.LISTtables.ListIndex) & "" & _
        " SET [" & FRMeditRow.fieldName(1).Caption & "] = '" & FRMeditRow.Field(1).Text & "'"
        
    For i = 2 To FRMeditRow.Field.Count - 1 - 5
    
        openStr = openStr & _
            " , " & _
            "[" & _
            FRMeditRow.fieldName(i).Caption & _
            "] = '" & _
            FRMeditRow.Field(i).Text & "'"
            
    Next
    
    splitStrRowToUpdateList = Split(strRowToUpdateList, "||")
    
    openStr = openStr & " WHERE [" & FRMeditRow.fieldName(1).Caption & "] = '" & _
        splitStrRowToUpdateList(0) & "'"
    
    For i = 2 To UBound(splitStrRowToUpdateList) - 5
        openStr = openStr & " AND [" & FRMeditRow.fieldName(i).Caption & "] = '" & _
            splitStrRowToUpdateList(i - 1) & "'"
    Next
    'openStr = openStr & ";"
    'debug.print openStr
    X = 1
    rs.Open openStr, conn, 1, 3
    FRMmain.Adodc1.Refresh
    conn.Close
    Set rs = Nothing
    Set conn = Nothing
    Unload FRMeditRow
End Function
'-------------------------------------------------------'
'   Set the listBox for the import dialog               '
'-------------------------------------------------------'
Public Function setImportTablesCombo(importFileName As String)
    
    On Error Resume Next
    
    Dim conn As ADODB.Connection
    Dim rSchema As ADODB.Recordset
    Set conn = New ADODB.Connection
    conn.Open "Driver={Microsoft Excel Driver (*.xls)};DriverId=790;Dbq=" & importFileName
    Set rSchema = conn.OpenSchema(adSchemaTables)
    
    DLGimport.COMBimportFileTable.Clear
    Do Until rSchema.EOF
        If rSchema!TABLE_TYPE = "TABLE" Then
            DLGimport.COMBimportFileTable.AddItem (rSchema!TABLE_NAME)
        End If
        rSchema.MoveNext
    Loop
    If DLGimport.COMBimportFileTable.ListCount > 0 Then
        DLGimport.COMBimportFileTable.ListIndex = 0
    End If
    rSchema.Close
    conn.Close
    Set rSchema = Nothing
    Set conn = Nothing
    
End Function




